home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Highspeed pascal.adf / HSPascal / AmigaDemos / GraphicsDemo.pas next >
Pascal/Delphi Source File  |  1991-12-31  |  4KB  |  146 lines
  1. {--------------------------------------------------------------------------
  2.  
  3.                      HighSpeed Pascal for the Amiga
  4.  
  5.                              GRAPHICS DEMO
  6.  
  7.                   Programmed by Martin Eskildsen 1991
  8.  
  9.                   Copyright (c) 1991 by D-House I ApS
  10.                          All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 23.08.91 : First version
  16.     1.01 : 17.09.91 : Revised for new library versions
  17.     1.02 : 06.11.91 : Final for first release
  18.  
  19. --------------------------------------------------------------------------}
  20.  
  21. program GraphicsDemo;
  22.  
  23. uses Init, Intuition, Graphics;
  24.  
  25. { In this example, we have chosen to show how "software clipping" can be
  26.   done, as we would otherwise have to involve layers. Therefore all procs
  27.   below do some checks to ensure the correctness of the produced coordinates
  28. }
  29.  
  30. procedure DrawLines;
  31. var
  32.   i            : integer;               { FOR index }
  33.   stepX, stepY : real;                  { X and Y increments }
  34.   xoffs, yoffs : integer;               { Where to start }
  35. begin
  36.   with WorkArea do begin
  37.     stepX := (maxX - minX) / 30;
  38.     stepY := (maxY - minY) / 30;
  39.     for i := 0 to 30 do with OutputWindow^ do begin
  40.       xoffs := round(stepX * i);
  41.       yoffs := round(stepY * i);
  42.       Move_(RPort, minX, minY + yoffs);    Draw(RPort, minX + xoffs, maxY);
  43.       Move_(RPort, maxX, minY + yoffs);    Draw(RPort, maxX - xoffs, maxY)
  44.     end
  45.   end
  46. end;
  47.  
  48. procedure DrawEllipses;
  49. var
  50.   i            : integer;
  51.   stepX, stepY : real;
  52.   x, y         : integer;
  53. begin
  54.  with WorkArea do begin
  55.    stepX := (maxX - minX - 6) / (30*2);
  56.    stepY := (maxY - minY - 6) / (30*2);
  57.    x     := (maxX - minX) div 2 + minX;
  58.    y     := (maxY - minY) div 2 + minY;
  59.    for i := 1 to 30 do with OutputWindow^ do
  60.      DrawEllipse(RPort, x, y, round(i * stepX), round(i * stepY) )
  61.  end
  62. end;
  63.  
  64. { The circle display presented by the below procedure isn't very nice, but
  65.   here Commodore-Amiga is to blame for making a poor circle procedure }
  66. procedure DrawCircles;
  67. var
  68.   i, x, y, r : integer;         { Index, x,y and radius }
  69. begin
  70.   with WorkArea do begin
  71.     for i := 1 to 40 do begin
  72.       repeat
  73.         x := minX + random(maxX - minX);
  74.         y := minY + random(maxY - minY);
  75.         r := random(30);
  76.       until (x-r >= minX) and (y-r >= minY) and
  77.             (x+r <= maxX) and (y+r <= maxY);
  78.       DrawCircle(OutputWindow^.RPort, x, y, r)
  79.     end
  80.   end
  81. end;
  82.  
  83. procedure PlotPoints;
  84. var x, y, i : integer;
  85.     l       : longint;           { dummy value returned by WritePixel }
  86. begin
  87.   for i := 1 to 5000 do begin
  88.     x := Random(WorkArea.maxX);
  89.     y := Random(WorkArea.maxY);
  90.     if LegalPosition(x, y) then l := WritePixel(OutputWindow^.RPort, x, y)
  91.   end
  92. end;
  93.  
  94. procedure FillRectangles;
  95. var
  96.   i                     : integer;
  97.   color, Ocolor         : integer;      { Fill and Outline colors }
  98.   x1, y1, x2, y2        : integer;      { Upper, lower corners }
  99. begin
  100.   for i := 1 to 1000 do begin
  101.     color  := Random(4);
  102.     Ocolor := Random(4);
  103.     repeat
  104.       x1 := Random(WorkArea.maxX);  y1 := Random(WorkArea.maxY);
  105.       x2 := Random(WorkArea.maxX);  y2 := Random(WorkArea.maxY);
  106.       SwapMin(x1, x2);  { Make sure (x1, y1) < (x2, y2) }
  107.       SwapMin(y1, y2)
  108.     until LegalPosition(x1, y1) and LegalPosition(x2, y2) and (x1 < x2) and (y1 < y2);
  109.     with OutputWindow^ do begin
  110.       SetAPen (RPort,  color);                  { Fill color }
  111.       SetOPen (RPort, Ocolor);                  { Outline color }
  112.       RectFill(RPort, x1, y1, x2, y2)           { Do the fill }
  113.     end
  114.   end
  115. end;
  116.  
  117. begin
  118.   if PrepareEnvironment('Simple Graphics') then begin
  119.  
  120.     OpenOutputWindow;
  121.  
  122.     Message('First, the Lines');
  123.     DrawLines;
  124.  
  125.     Message('Let''s get Elliptical');
  126.     ClearOutputWindow;
  127.     DrawEllipses;
  128.  
  129.     Message('While we''re at it: Some "Circles" ...');
  130.     ClearOutputWindow;
  131.     DrawCircles;
  132.  
  133.     Message('Not to mention the Points');
  134.     ClearOutputWindow;
  135.     PlotPoints;
  136.  
  137.     Message('And finally the Filled Rectangles');
  138.     ClearOutputWindow;
  139.     FillRectangles;
  140.  
  141.     Message('Wow! That''s it then - get rid of that window!');
  142.     CloseOutputWindow;
  143.     CloseDown
  144.   end
  145. end.
  146.